home *** CD-ROM | disk | FTP | other *** search
- (* WinVer 1.0
- Stamps Windows EXEs or DLLs with the
- required Windows version (3.00 or 3.10)
- Author: Costas Kitsos
- CIS mail: 73667,1755
- *)
-
- Program WINVER;
-
- {$D WinVer 1.0 - Copyright (c) 1992, Costas Kitsos}
- {$I-,S-}
- {$R WinVer.RES}
-
- Uses WinTypes, WinProcs, Strings, WinDos, WObjects;
-
- CONST {Dialog Control Constants}
- id_Path = 101;
- id_File = 102;
- id_Dir = 103;
- id_Ver31 = 104;
- id_Ver30 = 105;
- id_Update = 106;
- id_Finfo = 107;
- id_Types = 108;
- id_About = 109;
-
- CONST {Program Constants}
- TheApp: PChar = 'WinVer';
- fsFileSpec = fsFileName + fsExtension;
- BufSize = 32768;
-
- { Source for TEXEHDR and TNEWHDR: Microsoft Systems Journal Vol 6, No 5}
-
- Type TEXEHDR=record { DOS 1, 2, 3, 4 .EXE header }
- ehSignature: Word; { signature bytes }
- ehcbLP: Word; { bytes on last page of file }
- ehcp: Word; { pages in file }
- ehcRelocation: Word; { count of relocation table entries}
- ehcParagraphHdr: Word; { size of header in paragraphs }
- ehMinAlloc: Word; { minimum extra paragraphs needed }
- ehMaxAlloc: Word; { maximum extra paragraphs needed }
- ehSS: Word; { initial (relative) SS value }
- ehSP: Word; { initial SP value }
- ehChecksum: Word; { checksum }
- ehIP: Word; { initial IP value }
- ehCS: Word; { initial (relative) CS value }
- ehlpRelocation: Word; { file address of relocation table }
- ehOverlayNo: Word; { overlay number }
- ehReserved: array [0..15] of Word; { reserved words }
- ehPosNewHdr: LongInt; { file address of new exe header }
- end;
-
- Type TNEWHDR=record { new .EXE header }
- nhSignature: Word; { signature bytes }
- nhVer: Char; { LINK version number }
- nhRev: Char; { LINK revision number }
- nhoffEntryTable: Word; { offset of Entry Table }
- nhcbEntryTable: Word; { number of bytes in Entry Table }
- nhCRC: LongInt; { checksum of whole file }
- nhFlags: Word; { flag word }
- nhAutoData: Word; { automatic data segment number }
- nhHeap: Word; { initial heap allocation }
- nhStack: Word; { initial stack allocation }
- nhCSIP: LongInt; { initial CS:IP setting }
- nhSSSP: LongInt; { initial SS:SP setting }
- nhcSeg: Word; { count of file segments }
- nhcMod: Word; { entries in Module Reference Table}
- nhcbNonResNameTable: Word; { size of non-resident name table }
- nhoffSegTable: Word; { offset of Segment Table }
- nhoffResourceTable: Word; { offset of Resource Table }
- nhoffResNameTable: Word; { offset of Resident Name Table }
- nhoffModRefTable: Word; { offset of Module Reference Table }
- nhoffImpNameTable: Word; { offset of Imported Names Table }
- nhoffNonResNameTable: LongInt; { offset of Non-resident Names Tab }
- nhcMovableEntries: Word; { count of movable entries }
- nhcAlign: Word; { segment alignment shift count }
- nhCRes: Word; { count of resource segments }
- nhExeType: Byte; { target OS (OS/2=1, Windows=2) }
- nhFlagsOther: Byte; { additional exe flags }
- nhGangStart: Word; { offset to gangload area }
- nhGangLength: Word; { length of gangload area }
- nhSwapArea: Word; { minimum code swap area size}
- nhExpVer: Word; { expected Windows version number }
- end;
-
- CONST {Executable Constants}
- OLD_EXESign = $5A4D; {Old EXE Signature}
- NEW_EXESign = $454E; {New EXE Signature}
- WIN_OS: Byte = 2; {Windows Operating System}
- WIN_31: Word = $30A; {ver Win 3.1}
- WIN_30: Word = $300; {ver Win 3.0}
-
-
- type
- TWinVerApp = object(TApplication)
- procedure InitInstance; virtual;
- procedure InitMainWindow; virtual;
- end;
-
- PWinVerWindow = ^TWinVerWindow;
- TWinVerWindow = object(TDlgWindow)
- FileName: array[0..fsPathName] of Char;
- Extension: array[0..fsExtension] of Char;
- FileSpec: array[0..fsFileSpec] of Char;
- constructor Init(AParent : PWindowsObject; ATitle : PChar);
- procedure SetupWindow ; virtual;
- function GetClassName : PChar; virtual;
- function UpdateListBoxes: Boolean;
- function GetFileName: Boolean;
- function UpdateFile(bVer31: Boolean) : Boolean;
- procedure GetWindowClass(var AWndClass : TWndClass); virtual;
- procedure idFile(var Msg : TMessage); virtual + id_First + id_File;
- procedure idDir(var Msg : TMessage); virtual + id_First + id_Dir;
- procedure idUpdate(var Msg : TMessage); virtual + id_First + id_Update;
- procedure idTypes(var Msg : TMessage); virtual + id_First + id_Types;
- procedure idFinfo(var Msg : TMessage); virtual + id_First + id_Finfo;
- procedure wmSysCommand(var Msg : TMessage); virtual + wm_First + wm_SysCommand;
- destructor Done; virtual;
- end;
-
- function GetFileName(FilePath: PChar): PChar;
- var
- P: PChar;
- begin
- P := StrRScan(FilePath, '\');
- if P = nil then P := StrRScan(FilePath, ':');
- if P = nil then GetFileName := FilePath else GetFileName := P + 1;
- end;
-
- function GetExtension(FilePath: PChar): PChar;
- var
- P: PChar;
- begin
- P := StrScan(GetFileName(FilePath), '.');
- if P = nil then GetExtension := StrEnd(FilePath) else GetExtension := P;
- end;
-
- function HasWildCards(FilePath: PChar): Boolean;
- begin
- HasWildCards := (StrScan(FilePath, '*') <> nil) or
- (StrScan(FilePath, '?') <> nil);
- end;
-
- function MakeFileName(Dest, Source, Ext: PChar): PChar;
- begin
- MakeFileName := StrLCat(StrLCopy(Dest, Source,
- GetExtension(Source) - Source), Ext, fsPathName);
- end;
-
- procedure FileDelete(FileName: PChar);
- var
- F: file;
- begin
- Assign(F, FileName);
- Erase(F);
- InOutRes := 0;
- end;
-
- procedure FileRename(CurName, NewName: PChar);
- var
- F: file;
- begin
- Assign(F, CurName);
- Rename(F, NewName);
- InOutRes := 0;
- end;
-
-
- constructor TWinVerWindow.Init(AParent : PWindowsObject;ATitle : PChar);
- begin
- TDlgWindow.Init(Nil, PChar(100));
- StrCopy(FileName, '*.EXE');
- Extension[0] := #0;
- end;
-
- procedure TWinVerWindow.SetupWindow;
- var
- hSysMenu: hMenu;
- begin
- TDlgWindow.SetupWindow;
- hSysMenu:=GetSystemMenu(HWindow, FALSE);
- RemoveMenu(hSysMenu, sc_Maximize, mf_ByCommand);
- RemoveMenu(hSysMenu, sc_Size, mf_ByCommand);
- AppendMenu(hSysMenu, mf_separator, 0, Nil);
- AppendMenu(hSysMenu, mf_string, id_About, '&About...');
- SendDlgItemMessage(HWindow, id_Types, cb_AddString, 0, LongInt(PChar('EXE files')));
- SendDlgItemMessage(HWindow, id_Types, cb_AddString, 0, LongInt(PChar('DLL files')));
- SendDlgItemMessage(HWindow, id_Types, cb_SetCurSel, 0, 0);
- CheckRadioButton(HWindow, id_Ver31, id_Ver30, id_Ver31);
- UpdateListBoxes;
- end;
-
- function TWinVerWindow.GetClassName : PChar;
- begin
- GetClassName := TheApp;
- end;
-
- procedure TWinVerWindow.GetWindowClass(var AWndClass : TWndClass);
- begin
- TDlgWindow.GetWindowClass(AWndClass);
- AWndClass.hIcon := LoadIcon(hInstance, PChar(800));
- end;
-
- function TWinVerWindow.GetFileName: Boolean;
- var
- FileLen: Word;
- i: Integer;
- begin
- GetFileName := False;
- i:=LoWord(SendDlgItemMessage(HWindow, id_File, lb_getcursel,0,0));
- SendDlgItemMessage(HWindow, id_File, lb_gettext,i,LongInt(@FileName));
- FileExpand(FileName, FileName);
- FileLen := StrLen(FileName);
- if (FileName[FileLen - 1] = '\') or HasWildCards(FileName) or
- (GetFocus = GetDlgItem(HWindow, id_Dir)) then begin
- if FileName[FileLen - 1] = '\' then StrLCat(FileName, FileSpec, fsPathName);
- if not UpdateListBoxes then MessageBeep(0);
- Exit;
- end;
- StrLCat(StrLCat(FileName, '\', fsPathName), FileSpec, fsPathName);
- if UpdateListBoxes then Exit;
- FileName[FileLen] := #0;
- AnsiLower(FileName);
- GetFileName := True;
- end;
-
-
-
- function TWinVerWindow.UpdateListBoxes: Boolean;
- var
- Result: Integer;
- Path: array[0..fsFileName] of Char;
- begin
- UpdateListBoxes := False;
- if DlgDirList(HWindow, FileName, id_File, id_Path, 0) <> 0 then
- begin
- DlgDirList(HWindow, '*.*', id_Dir, 0, $C010);
- StrLCopy(FileSpec, FileName, fsFileSpec);
- UpdateListBoxes := True;
- end;
- end;
-
- Procedure TWinVerWindow.idFile(var Msg : TMessage);
- begin
- case Msg.LParamHi of
- lbn_SelChange, lbn_DblClk:
- begin
- DlgDirSelect(HWindow, FileName, id_File);
- if Msg.LParamHi = lbn_DblClk then idUpdate(Msg);
- end;
- end;
- end;
-
- Procedure TWinVerWindow.idDir(var Msg : TMessage);
- begin
- case Msg.LParamHi of
- lbn_SelChange, lbn_DblClk:
- begin
- DlgDirSelect(HWindow, FileName, id_Dir);
- StrCat(FileName, FileSpec);
- if Msg.LParamHi = lbn_DblClk then UpdateListBoxes;
- end;
- end;
- end;
-
- function TWinVerWindow.UpdateFile(bVer31: Boolean) : Boolean;
- var
- Stamp, N: Word;
- L: Longint;
- Buffer: Pointer;
- TempName, BakName: array [0..fsPathName] of Char;
- InputFile, OutputFile: file;
- ExeHdr: tEXEHDR;
- NewHdr: tNEWHDR;
- const
- OutErr: PChar = 'Error writing output file.'#0;
-
- function Error(Stop: Boolean; Message: PChar): Boolean;
- begin
- if Stop then
- begin
- if Buffer <> Nil then FreeMem(Buffer, BufSize);
- if TFileRec(InputFile).Mode <> fmClosed then Close(InputFile);
- if TFileRec(OutputFile).Mode <> fmClosed then
- begin
- Close(OutputFile);
- Erase(OutputFile);
- end;
- InOutRes := 0;
- MessageBeep(mb_IconStop);
- MessageBox(HWindow, Message, 'Error', mb_IconStop + mb_Ok);
- end;
- Error := Stop;
- end;
-
- begin
- UpdateFile := False;
- MakeFileName(TempName, FileName, '.$$$');
- Assign(InputFile, FileName);
- Assign(OutputFile, TempName);
- Buffer := MemAlloc(BufSize);
- if Error(Buffer = Nil, 'Not enough memory for copy buffer.') then Exit;
- Reset(InputFile, 1);
- if Error(IOResult <> 0, 'Cannot open input file.') then Exit;
- Rewrite(OutputFile, 1);
- if Error(IOResult <> 0, 'Cannot create output file.') then Exit;
- L := FileSize(InputFile);
- while L > 0 do
- begin
- if L > BufSize then N := BufSize else N := L;
- BlockRead(InputFile, Buffer^, N);
- if Error(IOResult <> 0, 'Error reading input file.') then Exit;
- BlockWrite(OutputFile, Buffer^, N);
- if Error(IOResult <> 0, OutErr) then Exit;
- Dec(L, N);
- end;
- FreeMem(Buffer, BufSize);
- Buffer:=Nil;
- Close(InputFile);
- {Mark the File}
- Seek(OutputFile,0);
- BlockRead(OutputFile, ExeHdr, SizeOf(ExeHdr));
- if Error(IOResult <> 0, OutErr) then Exit;
- Seek(OutputFile,ExeHdr.ehPosNewHdr);
- BlockRead(OutputFile, NewHdr, SizeOf(NewHdr));
- if Error(IOResult <> 0, OutErr) then Exit;
- {Do some verification on the EXE or DLL}
- if (ExeHdr.ehSignature <> OLD_EXESign) or (NewHdr.nhExeType <> WIN_OS) or
- (NewHdr.nhSignature <> NEW_EXESign) Then Begin
- Error(TRUE, 'Unsupported File Format');
- Exit;
- end;
- if bVer31 Then Stamp:=WIN_31 else Stamp:=WIN_30;
- Seek(OutputFile,FilePos(Outputfile)-SizeOf(Word));
- if Error(IOResult <> 0, OutErr) then Exit;
- BlockWrite(OutputFile, Stamp, SizeOf(Stamp));
- if Error(IOResult <> 0, OutErr) then Exit;
- Close(OutputFile);
- if StrPos(FileName, '.exe') <> Nil then
- MakeFileName(BakName, FileName, '.ex$')
- else MakeFileName(BakName, FileName, '.dl$');
- FileDelete(BakName);
- FileRename(FileName, BakName);
- FileRename(TempName, FileName);
- UpdateFile := True;
- end;
-
-
- Procedure TWinVerWindow.idUpdate(var Msg : TMessage);
- var
- bVer31: Boolean;
- P: array[0..1] of PChar;
- S: array[0..127] of Char;
- InputFile : File;
- begin
- if not GetFileName then Exit;
- P[0] := FileName;
- Assign( InputFile, FileName );
- Reset(InputFile, 1);
- if IOResult <> 0 then
- begin
- InOutRes := 0;
- MessageBox(HWindow, 'Cannot open input file.', 'Error', mb_IconStop + mb_Ok);
- Exit;
- end;
- Close(InputFile);
- bVer31 := IsDlgButtonChecked(HWindow, id_Ver31) <> 0;
- if bVer31 then P[1] := 'Windows 3.10' else P[1] := 'Windows 3.00';
- WVSPrintF(S, 'Mark %s as a %s file?', P);
- if MessageBox(HWindow, S, 'Update',
- mb_IconQuestion + mb_YesNo + mb_DefButton2) <> id_Yes then Exit;
- if ( UpdateFile(bVer31) = False ) then Exit;
- WVSPrintF(S, 'Done marking %s (a backup file was created).', P);
- MessageBox(HWindow, S, 'Success', mb_IconInformation + mb_Ok);
- UpdateListBoxes;
- end;
-
-
- Procedure TWinVerWindow.idTypes(var Msg : TMessage);
- begin
- if Msg.LParamHi = cbn_SelChange then begin
- if SendDlgItemMessage(HWindow, id_Types, cb_GetCurSel, 0,0)=0 then
- StrCopy(FileName,'*.EXE') else StrCopy(FileName,'*.DLL');
- UpdateListBoxes;
- end;
- end;
-
-
- Procedure TWinVerWindow.idFinfo(var Msg : TMessage);
- var
- ExeHdr: tEXEHDR;
- NewHdr: tNEWHDR;
- InputFile:File;
- S: Array [0..511] of Char;
- W: Array [0..1] of Word;
-
- begin
- if not GetFileName then Exit;
- {$I+}
- Assign(InputFile, FileName);
- Reset(InputFile, 1);
- BlockRead(InputFile, ExeHdr, SizeOf(ExeHdr));
- Seek(InputFile,ExeHdr.ehPosNewHdr);
- BlockRead(InputFile, NewHdr, SizeOf(NewHdr));
- Close(InputFile);
- {$I-}
- if (ExeHdr.ehSignature <> OLD_EXESign) or (NewHdr.nhExeType <> WIN_OS) or
- (NewHdr.nhSignature <> NEW_EXESign) Then
- MessageBox(HWindow, 'Unsupported File Format', 'File Info', mb_ok or mb_IconStop)
- else begin
- StrCopy(S, FileName);
- StrCat(S,#10'is marked for Windows v%d.%02d');
- W[0]:=Hi(NewHdr.nhExpVer);
- W[1]:=Lo(NewHdr.nhExpVer);
- WvsPrintf(S, S, W);
- MessageBox(HWindow, S, 'File Info', mb_ok or mb_IconInformation);
- end;
- end;
-
- procedure TWinVerWindow.wmSysCommand(var Msg : TMessage);
- begin
- if Msg.wParam = id_About Then
- MessageBox(HWindow, 'WinVer 1.0'#10'Copyright ⌐ 1992, Costas Kitsos',
- 'About WinVer', mb_ok or mb_IconInformation)
- else DefWndProc(Msg);
- end;
-
- destructor TWinVerWindow.Done;
- begin
- TDlgWindow.Done;
- end;
-
-
- procedure TWinVerApp.InitMainWindow;
- begin
- MainWindow := New(PWinVerWindow, Init(Nil, TheApp));
- end;
-
-
- procedure TWinVerApp.InitInstance;
- begin
- TApplication.InitInstance;
- end;
-
- var
- App : TWinVerApp;
- begin
- App.Init(TheApp);
- App.Run;
- App.Done;
- end.
-